home *** CD-ROM | disk | FTP | other *** search
/ QBasic & Borland Pascal & C / Delphi5.iso / Runimage / Delphi50 / Source / Property Editors / DSDEFINE.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1999-08-11  |  13.3 KB  |  471 lines
  1.  
  2. {*******************************************************}
  3. {                                                       }
  4. {       Borland Delphi Visual Component Library         }
  5. {       Dataset Designer Define Field Dialog            }
  6. {                                                       }
  7. {       Copyright (c) 1997,99 Inprise Corporation       }
  8. {                                                       }
  9. {*******************************************************}
  10.  
  11. unit DSDefine;
  12.  
  13. interface
  14.  
  15. uses Windows, SysUtils, Messages, Classes, Graphics, Controls, Forms,
  16.   StdCtrls, ExtCtrls, Buttons, DB, DsgnIntf;
  17.  
  18. type
  19.   TDefineField = class(TForm)
  20.     OkBtn: TButton;
  21.     CancelBtn: TButton;
  22.     HelpBtn: TButton;
  23.     FieldGroup: TGroupBox;
  24.     ComponentNameLabel: TLabel;
  25.     FieldNameLabel: TLabel;
  26.     ComponentNameEdit: TEdit;
  27.     FieldNameEdit: TEdit;
  28.     FieldTypeList: TComboBox;
  29.     SizeEditLabel: TLabel;
  30.     SizeEdit: TEdit;
  31.     FieldKind: TRadioGroup;
  32.     LookupGroup: TGroupBox;
  33.     DatasetList: TComboBox;
  34.     DatasetLabel: TLabel;
  35.     KeyFieldsList: TComboBox;
  36.     LookupKeysList: TComboBox;
  37.     ResultFieldList: TComboBox;
  38.     KeyFieldsLabel: TLabel;
  39.     LookupKeysLabel: TLabel;
  40.     ResultFieldLabel: TLabel;
  41.     FieldTypeLabel: TLabel;
  42.     procedure FieldNameEditChange(Sender: TObject);
  43.     procedure FormCreate(Sender: TObject);
  44.     procedure OkBtnClick(Sender: TObject);
  45.     procedure DatasetListDropDown(Sender: TObject);
  46.     procedure LookupKeysListDropDown(Sender: TObject);
  47.     procedure KeyFieldsListDropDown(Sender: TObject);
  48.     procedure ResultFieldListDropDown(Sender: TObject);
  49.     procedure FieldKindClick(Sender: TObject);
  50.     procedure DatasetListChange(Sender: TObject);
  51.     procedure HelpBtnClick(Sender: TObject);
  52.     procedure FieldTypeListChange(Sender: TObject);
  53.   private
  54.     FDataset: TDataset;
  55.     FDesigner: IFormDesigner;
  56.     FDSDesigner: TDatasetDesigner;
  57.     FField: TField;
  58.     function GetCalculated: Boolean;
  59.     function GetComponentName: string;
  60.     function GetFieldClass: TFieldClass;
  61.     function GetFieldName: string;
  62.     function GetLookup: Boolean;
  63.     function GetLookupDataset: TDataset;
  64.     function GetKeyFields: string;
  65.     function GetLookupKeyFields: string;
  66.     function GetLookupResultField: string;
  67.     procedure GetLookupFields(Items: TStrings);
  68.     function GetSize: Integer;
  69.     procedure SetCalculated(Value: Boolean);
  70.     procedure SetComponentName(const Value: string);
  71.     procedure SetDataset(Value: TDataset);
  72.     procedure SetFieldClass(Value: TFieldClass);
  73.     procedure SetFieldName(const Value: string);
  74.     procedure SetLookup(Value: Boolean);
  75.     procedure SetSize(Value: Integer);
  76.     procedure UpdateLookupControls;
  77.   public
  78.     procedure ConfigureForLookupOnly(const ADataSet, AKey, ALookup,
  79.       AResult, AType: string; ASize: Word);
  80.     property Calculated: Boolean read GetCalculated write SetCalculated;
  81.     property Lookup: Boolean read GetLookup write SetLookup;
  82.     property ComponentName: string read GetComponentName
  83.       write SetComponentName;
  84.     property FieldClass: TFieldClass read GetFieldClass write SetFieldClass;
  85.     property FieldName: string read GetFieldName write SetFieldName;
  86.     property Field: TField read FField;
  87.     property Size: Integer read GetSize write SetSize;
  88.     property LookupDataset: TDataset read GetLookupDataset;
  89.     property KeyFields: string read GetKeyFields;
  90.     property LookupKeyFields: string read GetLookupKeyFields;
  91.     property LookupResultField: string read GetLookupResultField;
  92.     property Dataset: TDataset read FDataset write SetDataset;
  93.     property Designer: IFormDesigner read FDesigner write FDesigner;
  94.     property DSDesigner: TDatasetDesigner read FDSDesigner write FDSDesigner;
  95.   end;
  96.  
  97. function ClassNameNoT(FieldClass: TFieldClass): string;
  98.  
  99. var
  100.   DefineField: TDefineField;
  101.  
  102. implementation
  103.  
  104. uses DsnDBCst, DBConsts, Dialogs, DSDesign, LibHelp, TypInfo;
  105.  
  106. {$R *.DFM}
  107.  
  108. var
  109.   FieldClasses: TList;
  110.  
  111. function ClassNameNoT(FieldClass: TFieldClass): string;
  112. begin
  113.   Result := FieldClass.ClassName;
  114.   if Result[1] = 'T' then Delete(Result, 1, 1);
  115.   if CompareText('Field', Copy(Result, Length(Result) - 4, 5)) = 0 then { do not localize }
  116.     Delete(Result, Length(Result) - 4, 5);
  117. end;
  118.  
  119. procedure RegFields(const AFieldClasses: array of TFieldClass); far;
  120. var
  121.   I: Integer;
  122. begin
  123.   if FieldClasses = nil then FieldClasses := TList.Create;
  124.   for I := Low(AFieldClasses) to High(AFieldClasses) do
  125.     if FieldClasses.IndexOf(AFieldClasses[I]) = -1 then
  126.     begin
  127.       FieldClasses.Add(AFieldClasses[I]);
  128.       RegisterClass(AFieldClasses[I]);
  129.     end;
  130. end;
  131.  
  132. function FindFieldClass(const FieldClassName: string): TFieldClass;
  133. var
  134.   I: Integer;
  135. begin
  136.   for I := 0 to FieldClasses.Count - 1 do
  137.   begin
  138.     Result := FieldClasses[I];
  139.     if (CompareText(FieldClassName, Result.ClassName) = 0)
  140.       or (CompareText(FieldClassName, ClassNameNoT(Result)) = 0) then
  141.       Exit;
  142.   end;
  143.   Result := nil;
  144. end;
  145.  
  146. { TNewField }
  147.  
  148. procedure TDefineField.FormCreate(Sender: TObject);
  149. var
  150.   I: Integer;
  151. begin
  152.   for I := 0 to FieldClasses.Count - 1 do
  153.     FieldTypeList.Items.Add(ClassNameNoT(FieldClasses[I]));
  154.   HelpContext := hcDDefineField;
  155. end;
  156.  
  157. function TDefineField.GetCalculated: Boolean;
  158. begin
  159.   Result := FieldKind.ItemIndex = 1;
  160. end;
  161.  
  162. function TDefineField.GetComponentName: string;
  163. begin
  164.   Result := ComponentNameEdit.Text;
  165. end;
  166.  
  167. function TDefineField.GetFieldClass: TFieldClass;
  168. begin
  169.   Result := FindFieldClass(FieldTypeList.Text);
  170. end;
  171.  
  172. function TDefineField.GetFieldName: string;
  173. begin
  174.   Result := FieldNameEdit.Text;
  175. end;
  176.  
  177. function TDefineField.GetLookup: Boolean;
  178. begin
  179.   Result := FieldKind.ItemIndex = 2;
  180. end;
  181.  
  182. function TDefineField.GetLookupDataset: TDataset;
  183. begin
  184.   Result := Designer.GetComponent(DatasetList.Text) as TDataset;
  185. end;
  186.  
  187. function TDefineField.GetKeyFields: string;
  188. begin
  189.   Result := KeyFieldsList.Text;
  190. end;
  191.  
  192. function TDefineField.GetLookupKeyFields: string;
  193. begin
  194.   Result := LookupKeysList.Text;
  195. end;
  196.  
  197. function TDefineField.GetLookupResultField: string;
  198. begin
  199.   Result := ResultFieldList.Text;
  200. end;
  201.  
  202. function TDefineField.GetSize: Integer;
  203. begin
  204.   Result := -1;
  205.   if SizeEdit.Text <> '' then Result := StrToInt(SizeEdit.Text);
  206. end;
  207.  
  208. procedure TDefineField.SetCalculated(Value: Boolean);
  209. begin
  210.   if Value or not Lookup then
  211.     FieldKind.ItemIndex := Ord(Value);
  212. end;
  213.  
  214. procedure TDefineField.SetComponentName(const Value: string);
  215. begin
  216.   ComponentNameEdit.Text := Value;
  217. end;
  218.  
  219. procedure TDefineField.SetDataset(Value: TDataset);
  220. begin
  221.   FDataset := Value;
  222.   FieldNameEdit.Text := '';
  223. end;
  224.  
  225. procedure TDefineField.SetFieldClass(Value: TFieldClass);
  226. begin
  227.   if Value <> nil then
  228.     with FieldTypeList do
  229.       ItemIndex := Items.IndexOf(ClassNameNoT(Value));
  230. end;
  231.  
  232. procedure TDefineField.SetFieldName(const Value: string);
  233. begin
  234.   FieldNameEdit.Text := Value;
  235. end;
  236.  
  237. procedure TDefineField.SetLookup(Value: Boolean);
  238. begin
  239.   if Value or not Calculated then
  240.     FieldKind.ItemIndex := Ord(Value) * 2;
  241. end;
  242.  
  243. procedure TDefineField.SetSize(Value: Integer);
  244. begin
  245.   SizeEdit.Text := IntToStr(Value);
  246. end;
  247.  
  248. procedure TDefineField.FieldNameEditChange(Sender: TObject);
  249. var
  250.   I: Integer;
  251. begin
  252.   if FieldName <> '' then
  253.     ComponentName := CreateUniqueName(Dataset, FieldName, FieldClass, nil) else
  254.     ComponentName := '';
  255.   I := Dataset.FieldDefs.IndexOf(FieldName);
  256.   if I >= 0 then FieldClass := Dataset.FieldDefs[I].FieldClass;
  257.   if (Dataset.FieldDefs.Count <> 0) and (FieldKind.ItemIndex = 0) then
  258.     Calculated := I < 0;
  259. end;
  260.  
  261. procedure TDefineField.OkBtnClick(Sender: TObject);
  262. var
  263.   ErrorFound: Boolean;
  264.  
  265.   procedure ErrorMsg(const Msg: string; L: TLabel);
  266.   begin
  267.     MessageDlg(Msg, mtError, [mbOK], 0);
  268.     if L.FocusControl <> nil then L.FocusControl.SetFocus;
  269.     ErrorFound := True;
  270.   end;
  271.  
  272.   procedure Error(L: TLabel);
  273.   var
  274.     C: string;
  275.     I: Integer;
  276.   begin
  277.     C := L.Caption;
  278.     if SysLocale.FarEast then // Far East label shortcuts are 'xxxx(&s):'
  279.     begin
  280.       I := Length(C) - 4;
  281.       if (I > 0) and (C[I] = '(') and (C[I+1] = '&') and (C[I+3] = ')') and
  282.         (C[I+4] = ':') then
  283.         Delete(C, I, 4);
  284.     end
  285.     else
  286.       for I := Length(C) downto 1 do
  287.         if C[I] in ['&',':'] then Delete(C, I, 1);
  288.     ErrorMsg(Format(SDSMustBeSpecified, [C]), L);
  289.   end;
  290.  
  291. begin
  292.   ModalResult := mrNone;
  293.   ErrorFound := False;
  294.   if FieldName = '' then Error(FieldNameLabel)
  295.   else if FieldClass = nil then Error(FieldTypeLabel)
  296.   else if ComponentName = '' then Error(ComponentNameLabel)
  297.   else if Lookup then
  298.     if LookupDataset = nil then Error(DatasetLabel)
  299.     else if LookupDataset = Dataset then
  300.       ErrorMsg(SCircularDataLink, DatasetLabel)
  301.     else if LookupKeyFields = '' then Error(LookupKeysLabel)
  302.     else if KeyFields = '' then Error(KeyFieldsLabel)
  303.     else if LookupResultField = '' then Error(ResultFieldLabel);
  304.   if ErrorFound then Exit;
  305.   FField := FieldClass.Create(Dataset.Owner);
  306.   try
  307.     Field.Name := ComponentName;
  308.     Field.FieldName := FieldName;
  309.     if Calculated then
  310.       Field.FieldKind := fkCalculated
  311.     else if Lookup then
  312.     begin
  313.       Field.FieldKind := fkLookup;
  314.       Field.LookupDataset := LookupDataset;
  315.       Field.KeyFields := KeyFields;
  316.       Field.LookupKeyFields := LookupKeyFields;
  317.       Field.LookupResultField := LookupResultField;
  318.     end
  319.     else if FieldKind.ItemIndex = 3 then
  320.       Field.FieldKind := fkInternalCalc
  321.     else if FieldKind.ItemIndex = 4 then
  322.     begin
  323.       Field.FieldKind := fkAggregate;
  324.       Field.Visible := False;
  325.     end;
  326.     if Size <> -1 then Field.Size := Size;
  327.     DSDesigner.BeginDesign;
  328.     try
  329.       Field.Dataset := Dataset;
  330.     finally
  331.       DSDesigner.EndDesign;
  332.     end;
  333.   except
  334.     Field.Free;
  335.     raise;
  336.   end;
  337.   ModalResult := mrOK;
  338. end;
  339.  
  340. procedure TDefineField.UpdateLookupControls;
  341. var
  342.   LookupDatasetValid: Boolean;
  343. begin
  344.   LookupDatasetValid := Lookup and (Designer.GetComponent(DatasetList.Text) <> nil);
  345.   DatasetList.Enabled := Lookup;
  346.   DatasetLabel.Enabled := Lookup;
  347.   KeyFieldsList.Enabled := Lookup;
  348.   KeyFieldsLabel.Enabled := Lookup;
  349.   LookupKeysList.Enabled := LookupDatasetValid;
  350.   LookupKeysLabel.Enabled := LookupDatasetValid;
  351.   ResultFieldList.Enabled := LookupDatasetValid;
  352.   ResultFieldLabel.Enabled := LookupDatasetValid;
  353. end;
  354.  
  355. procedure TDefineField.DatasetListDropDown(Sender: TObject);
  356. var
  357.   OldValue: string;
  358. begin
  359.   OldValue := DatasetList.Text;
  360.   DatasetList.Clear;
  361.   Designer.GetComponentNames(GetTypeData(TDataset.ClassInfo),
  362.     DatasetList.Items.Append);
  363.   DatasetList.Text := OldValue;
  364. end;
  365.  
  366. procedure TDefineField.KeyFieldsListDropDown(Sender: TObject);
  367. var
  368.   OldValue: string;
  369. begin
  370.   OldValue := KeyFieldsList.Text;
  371.   KeyFieldsList.Clear;
  372.   Dataset.GetFieldNames(KeyFieldsList.Items);
  373.   KeyFieldsList.Text := OldValue;
  374. end;
  375.  
  376. procedure TDefineField.GetLookupFields(Items: TStrings);
  377. var
  378.   LookupDataset: TDataset;
  379. begin
  380.   LookupDataset := Designer.GetComponent(DatasetList.Text) as TDataset;
  381.   if LookupDataset <> nil then LookupDataset.GetFieldNames(Items);
  382. end;
  383.  
  384. procedure TDefineField.LookupKeysListDropDown(Sender: TObject);
  385. var
  386.   OldValue: string;
  387. begin
  388.   OldValue := LookupKeysList.Text;
  389.   LookupKeysList.Clear;
  390.   GetLookupFields(LookupKeysList.Items);
  391.   LookupKeysList.Text := OldValue;
  392. end;
  393.  
  394. procedure TDefineField.ResultFieldListDropDown(Sender: TObject);
  395. var
  396.   OldValue: string;
  397. begin
  398.   OldValue := ResultFieldList.Text;
  399.   ResultFieldList.Clear;
  400.   GetLookupFields(ResultFieldList.Items);
  401.   ResultFieldList.Text := OldValue;
  402. end;
  403.  
  404. procedure TDefineField.FieldKindClick(Sender: TObject);
  405. begin
  406.   if FieldKind.ItemIndex = 4 then
  407.     FieldTypeList.Text := 'Aggregate'; { do not localize }
  408.   UpdateLookupControls;
  409. end;
  410.  
  411. procedure TDefineField.DatasetListChange(Sender: TObject);
  412. begin
  413.   UpdateLookupControls;
  414. end;
  415.  
  416. procedure TDefineField.HelpBtnClick(Sender: TObject);
  417. begin
  418.   Application.HelpContext(HelpContext);
  419. end;
  420.  
  421. type
  422.   TFieldAccess = class(TField);
  423.   TFieldAccessClass = class of TFieldAccess;
  424.  
  425. procedure TDefineField.FieldTypeListChange(Sender: TObject);
  426. var
  427.   FieldClass: TFieldClass;
  428. begin
  429.   if (FieldTypeList.Text <> '') then
  430.   try
  431.     FieldClass := Self.FieldClass;
  432.     if Assigned(FieldClass) then
  433.       TFieldAccessClass(FieldClass).CheckTypeSize(1);
  434.     SizeEdit.Enabled := True;
  435.   except
  436.     SizeEdit.Text := '0'; { do not localize }
  437.     SizeEdit.Enabled := False;
  438.   end;
  439. end;
  440.  
  441. resourcestring
  442.   SNewLookupFieldCaption = 'New Lookup Field';
  443.  
  444. procedure TDefineField.ConfigureForLookupOnly(const ADataSet, AKey, ALookup,
  445.   AResult, AType: string; ASize: Word);
  446. var
  447.   vDelta: Integer;
  448. begin
  449.   Lookup := True;
  450.   FieldKind.Hide;
  451.   vDelta := LookupGroup.Top - FieldKind.Top;
  452.   LookupGroup.Top := FieldKind.Top;
  453.   OkBtn.Top := OkBtn.Top - vDelta;
  454.   CancelBtn.Top := CancelBtn.Top - vDelta;
  455.   HelpBtn.Top := HelpBtn.Top - vDelta;
  456.   Height := Height - vDelta;
  457.   Caption := SNewLookupFieldCaption;
  458.   DataSetList.Text := ADataSet;
  459.   KeyFieldsList.Text := AKey;
  460.   LookupKeysList.Text := ALookup;
  461.   ResultFieldList.Text := AResult;
  462.   SizeEdit.Text := IntToStr(ASize);
  463.   FieldTypeList.Text := AType;
  464.   UpdateLookupControls;
  465. end;
  466.  
  467. initialization
  468.   RegisterFieldsProc := RegFields;
  469.  
  470. end.
  471.